unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, SvcMgr, ShellApi, TlHelp32;

type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    FAppList: TStringList;
    function pKill(ExeFileName: string): Boolean;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
(*
   AppAsService.cfg example: <program>;<parameters>

   c:\program files\Mozilla Firefox\firefox.exe;http:\\www.google.com

*)
var
  lPath: string;
  lName: string;
  I: Integer;
  lApp: PChar;
  lParams: PChar;
begin
  lPath := ExtractFilePath(ParamStr(0));
  lName := ExtractFileName(ParamStr(0));
  lName := Copy(lName, 0, Pos('.', lName) - 1);

  FAppList := TStringList.Create;
  FAppList.LoadFromFile(lPath + lName +'.conf');
  for I := FAppList.Count - 1 to 0 do
  begin
    lApp := PChar(Copy(FAppList[I], 0, Pos(';', FAppList[I]) - 1));
    if not FileExists(lApp) then
      FAppList.Delete(I)
    else
    begin
      (* ShellExecute the app *)
      lParams := PChar(Copy(FAppList[I], Pos(';', FAppList[I]) + 1, Length(FAppList[I])));
      ShellExecute(0, 'open', lApp, lParams, PChar(ExtractFilePath(lApp)), SW_NORMAL);
      (* Replace FApplist[I] by the AppName *)
      FAppList[I] := ExtractFileName(lApp);
    end;
  end;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
var
  I: Integer;
  lProcess: Cardinal;
  lProcHandle: Cardinal;
  lExitCode: Cardinal;
begin
  for I := 0 to FAppList.Count - 1 do
    pKill(FAppList[I]);
  FAppList.Free;
end;


function TService1.pKill(ExeFileName: string): Boolean;
const
  PROCESS_TERMINATE=$0001;
var
  ContinueLoop: BOOL;FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  result := False;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName))
      or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then
    Result := TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),
      FProcessEntry32.th32ProcessID), 0);
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

end.

